home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / X11 / tclMotif-1.4 / tests / arrow.test < prev    next >
Text File  |  1995-06-29  |  2KB  |  125 lines
  1.  
  2. if {[string compare test [info procs test]] == 1} then \
  3.   {source defs}
  4.  
  5. # set VERBOSE 1
  6.  
  7. proc arrowSize {} {
  8.   .arrow getValues \
  9.     -unitType t \
  10.     -width w \
  11.     -height h
  12.   return "$t $w $h"
  13. }
  14.  
  15. proc setDirection {dir} {
  16.     .arrow setValues -arrowDirection $dir
  17.     .arrow getValues -arrowDirection d
  18.     return $d
  19. }
  20.  
  21. xtAppInitialize -class Arrow
  22. . setValues -allowShellResize true
  23.  
  24. xmArrowButton .arrow managed \
  25.   -width 100 -height 100
  26.  
  27. . realizeWidget
  28.  
  29. ##################
  30. # Arrow Directions
  31. ##################
  32.  
  33. if {$XmVersion >= 1002} {
  34. test arrow-1.1 {arrow direction down} {
  35.     setDirection arrow_down
  36. } {arrow_down}
  37.  
  38. test arrow-1.2 {arrow direction left} {
  39.     setDirection arrow_left
  40. } {arrow_left}
  41.  
  42. test arrow-1.3 {arrow direction right} {
  43.     setDirection arrow_right
  44. } {arrow_right}
  45.  
  46. test arrow-1.4 {arrow direction up} {
  47.     setDirection arrow_up
  48. } {arrow_up}
  49. }
  50.  
  51. #############################
  52. # setup for arrow callbacks #
  53. #############################
  54.  
  55. proc armCB {} {
  56.     return "...armed"
  57. }
  58.  
  59. proc activateCB {} {
  60.     return "...activated"
  61. }
  62.  
  63. proc disarmCB {} {
  64.     return "...disarmed"
  65. }
  66.  
  67. .arrow armCallback armCB
  68. .arrow activateCallback activateCB
  69. .arrow disarmCallback disarmCB
  70.  
  71. #################
  72. # Arrow callbacks
  73. #################
  74.  
  75. test arrow-2.1 {arrow arm} {
  76.     .arrow callActionProc Arm()
  77. } {...armed}
  78.  
  79. # activate assumes it comes from a ButtonPress.
  80. # coords within its boundaries mean ButtonRelease
  81. # occurs within the widget, so activate callback occurs.
  82. # outside this, no callback is invoked
  83.  
  84. # this one is inside boundary
  85. test arrow-2.2 {arrow activate } {
  86.     .arrow callActionProc Activate() \
  87.         -type ButtonPress \
  88.         -x 0 -y 0
  89. } {...activated}
  90.  
  91. test arrow-2.3 {arrow disarm} {
  92.     .arrow callActionProc Disarm()
  93. } {...disarmed}
  94.  
  95. test arrow-2.3 {arrow armAndActivate} {
  96.     .arrow callActionProc ArmAndActivate()
  97. } {...armed...activated...disarmed}
  98.  
  99. .arrow destroyWidget
  100.  
  101. ###################################
  102. # setup arrow for % substitutions #
  103. ###################################
  104.  
  105. proc armCB {w} {
  106.   return $w
  107. }
  108.  
  109. xmArrowButton .arrow2 managed
  110. .arrow2 armCallback {armCB %w}
  111.  
  112. ##################
  113. # %w substitiution
  114. ##################
  115. test arrow-3.1 {%w substitution} {
  116.     .arrow2 callActionProc Arm()
  117. } {.arrow2}
  118.  
  119. .arrow2 destroyWidget
  120.  
  121. # we don't want to go into interactivity:
  122. # . mainLoop
  123.  
  124.  
  125.